home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Especial Multimedia
/
Especial Multimedia.iso
/
Multimed
/
Herra
/
QVIEW.ZIP
/
MAIN.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1997-09-14
|
4KB
|
163 lines
unit Main;
interface
uses
SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
Forms, Dialogs, StdCtrls, Buttons, ExtCtrls, Menus, FileCtrl, Placemnt,
About;
type
TMainForm = class(TForm)
StatusLine: TPanel;
DirectoryListBox1: TDirectoryListBox;
FileListBox1: TFileListBox;
DriveComboBox1: TDriveComboBox;
FilterComboBox1: TFilterComboBox;
GroupBox1: TGroupBox;
Panel1: TPanel;
Image1: TImage;
CBStretch: TCheckBox;
CBAutoSize: TCheckBox;
CBCenter: TCheckBox;
BCopyFile: TBitBtn;
SaveDialog1: TSaveDialog;
BitBtn1: TBitBtn;
BitBtn2: TBitBtn;
CBRatio: TCheckBox;
Placement1: TPlacement;
procedure FormCreate(Sender: TObject);
procedure ShowHint(Sender: TObject);
procedure CBStretchClick(Sender: TObject);
procedure CBAutoSizeClick(Sender: TObject);
procedure CBCenterClick(Sender: TObject);
procedure BCopyFileClick(Sender: TObject);
procedure FileListBox1Change(Sender: TObject);
procedure BitBtn1Click(Sender: TObject);
procedure CBRatioClick(Sender: TObject);
procedure BitBtn2Click(Sender: TObject);
procedure FormDestroy(Sender: TObject);
end;
var
MainForm: TMainForm;
implementation
{$R *.DFM}
procedure TMainForm.FormCreate(Sender: TObject);
begin
Application.OnHint := ShowHint;
Placement1.IniFileName := ChangeFileExt(Paramstr(0), '.INI');
Placement1.Read;
end;
procedure TMainForm.ShowHint(Sender: TObject);
begin
StatusLine.Caption := Application.Hint;
end;
procedure TMainForm.CBStretchClick(Sender: TObject);
begin
Image1.Stretch := CBStretch.Checked;
end;
procedure TMainForm.CBAutoSizeClick(Sender: TObject);
begin
Image1.AutoSize := CBAutoSize.Checked;
if not Image1.AutoSize then begin
Image1.Height := Panel1.Height-10;
Image1.Width := Panel1.Width-10;
end;
end;
procedure TMainForm.CBCenterClick(Sender: TObject);
begin
Image1.Center := CBCenter.Checked;
end;
procedure TMainForm.BCopyFileClick(Sender: TObject);
Const BufLength = 2000;
Var fS, fD : File;
Buf : ^Byte;
NumRead,
NumWritten : Word;
Ext : String;
begin
Ext := UpperCase(ExtractFileExt(FileListBox1.FileName));
if Ext='.BMP' then
SaveDialog1.Filter := 'Bitmaps|*.BMP';
if Ext='.WMF' then
SaveDialog1.Filter := 'Windows Meta Files|*.WMF';
if Ext='.ICO' then
SaveDialog1.Filter := 'Icons|*.ICO';
if SaveDialog1.Execute then begin
FileMode := 0;
getmem(Buf, BufLength);
if Buf=NIL then
exit;
AssignFile(fS, FileListBox1.FileName);
Reset(fS, 1);
AssignFile(fD, SaveDialog1.FileName);
Rewrite(fD, 1);
repeat
BlockRead(fS, Buf^, BufLength-1, NumRead);
BlockWrite(fD, Buf^, NumRead, NumWritten);
until eof(fS) or (NumRead=0) or (NumWritten<>NumRead);
CloseFile(fD);
CloseFile(fS);
end;
FileListBox1.Refresh;
end;
procedure TMainForm.FileListBox1Change(Sender: TObject);
begin
if FileListBox1.ItemIndex>=0 then begin
try
Image1.Picture.LoadFromFile(FileListBox1.FileName);
except
MessageDlg('Error loading file!', mtError, [mbOK], 0);
Image1.Picture := NIL;
end;
if CBRatio.Checked then begin
if Image1.Picture.Height>=Image1.Picture.Width then begin
Image1.Height := Panel1.Height-10;
Image1.Width := Round(LONGINT(Image1.Picture.Height)*LONGINT(Image1.Height)/Image1.Picture.Width);
end
else begin
Image1.Width := Panel1.Width-10;
Image1.Height := Round(LONGINT(Image1.Picture.Height)*LONGINT(Image1.Width)/Image1.Picture.Width);
end;
end;
end;
end;
procedure TMainForm.BitBtn1Click(Sender: TObject);
begin
Close;
end;
procedure TMainForm.CBRatioClick(Sender: TObject);
begin
if not CBRatio.Checked then begin
Image1.Height := Panel1.Height-10;
Image1.Width := Panel1.Width-10;
end;
FileListBox1Change(self);
end;
procedure TMainForm.BitBtn2Click(Sender: TObject);
begin
Application.CreateForm(TAboutBox, AboutBox);
AboutBox.ShowModal;
AboutBox.Free;
end;
procedure TMainForm.FormDestroy(Sender: TObject);
begin
Placement1.Write;
end;
end.